COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FORNAM
C00010 ENDMK
C⊗;
	TITLE FORNAM
	INTERNAL FORNAM     ;USE THIS TO SET NAME.EXT FOR FORTRAN READING OR
	ENTRY RENAM   		;RENAMES ANY FILES

	EXTERNAL FILES.	    ;FROM F40 IO STUFF.  WRITING ON DSK (DEV.1 ONLY!)
FORNAM:	0		;CALL FORNAM(<FILE NAME>,<EXTENSION>)
	MOVE 0,@0(16)
	MOVEM 0,FN#
	MOVE 1,[POINT 7,FN]	   ;CHANGES NAMES TO SIXBIT
INTF3:	MOVE 2,[POINT 6,FILES.]
	SETZM FILES.
	MOVEI 3,5
INTF1:	ILDB 0,1
	CAIN 0," "
	JRST INTF2
	SUBI 0,40
	IDPB 0,2
	SOJG 3,INTF1
INTF2:	MOVE 0,@1(16)
	MOVEM 0,EX#
	MOVE 1,[POINT 7,EX]
EXTF3:	MOVE 2,[POINT 6,FILES.+1]
	SETZM FILES.+1
	MOVEI 3,5
EXTF1:	ILDB 0,1
	CAIN 0," "
	JRA 16,2(16)
	SUBI 0,40
	IDPB 0,2
	SOJG 3,EXTF1
	JRA 16,2(16)


	A←1 ↔ B←2 ↔ C←3 ↔ P←17 ↔ SVN ← 4 ↔ CHN ← 11

	;RENAME FOR FORTRAN
	; CALL(OLDNAME,OLDEXT,NEWNAME,NEWEXT)
	; HALTS ON ERROR OR FILE NOT FOUND
	

RENAM:	0
	HRRZI REGS
	BLT REGS+4
	EXCH P,SVP

GONE:	MOVE SVN,@(16)		;FIRST FILE NAME
	MOVE B,[POINT 6,NAME]
	PUSHJ P,SEVN26

	MOVE SVN,@1(16)		;FIRST EXT
	MOVE B,[POINT 6,NAME+1]
	PUSHJ P,SEVN26
	
	SETZM NAME+3		;NO PPN

	OPEN CHN,[14↔'DSK   '↔0]
	JRST ERROR
	LOOKUP CHN,NAME
	JRST ERROR

	MOVE SVN,@2(16)		;SECOND FILE NAME
	MOVE B,[POINT 6,NAME]
	PUSHJ P,SEVN26

	MOVE SVN,@3(16)		;SECOND EXT
	MOVE B,[POINT 6,NAME+1]
	PUSHJ P,SEVN26
	
	SETZM NAME+3		;NO PPN??
	RENAME CHN,NAME
	JRST CKDEL		;CHECK FOR OLD FILE

	HRLZI REGS
	BLT 4
	EXCH P,SVP
	JRA 16,4(16)


SEVN26:	MOVE A,[POINT 7,SVN]	;SEVEN TO SIXBIT
	SETZM (B)
	MOVEI C,5
SIXOOP:	ILDB A
	CAIN " "
	POPJ P,
	SUBI 40
	IDPB B
	SOJG C,SIXOOP
	POPJ P,	

CKDEL:	HRRZ NAME+1
	CAIE 4		;SEE IF FILE EXISTS
	JRST ERROR

	OPEN 12,[14↔'DSK   '↔0]
	JRST ERROR
	SETZM NAME+3
	LOOKUP 12,NAME
	JRST ERROR

	SETZM NAME
	RENAME 12,NAME	;DELETE IT
	JRST 4,.
	JRST GONE
	
ERROR:			;GETS HERE IF ERROR OR FILE NOT FOUND

	JRST 4,.	;HALT

NAME:	BLOCK 4
REGS:	BLOCK 5
SVP:	-10,,PDL
PDL:	BLOCK 10

END